home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
faq-s.zip
/
NET.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-01-13
|
5KB
|
184 lines
procedure dounzipnetmail;
var sqlf:file of bulrec;
mesf:file of message;
textf:message;
thefn:sstr;
filename:sstr;
b:bulrec;
f1:file;
ourf:string;
ourf2:string;
numb,cnt:integer;
procedure seekbfile (n:integer);
begin
seek (bfile,n-1); che
end;
function numbuls:integer;
begin
numbuls:=filesize(bfile);
end;
procedure addbul (var b:bulrec);
var b2:bulrec;
begin
assign (bfile,datadir+curboard.shortname+'.MS'+strr(conn));
reset (bfile);
if numbuls=0 then b.id:=1 else begin
seekbfile (numbuls);
read (bfile,b2);
if b2.id=65535
then b.id:=1
else b.id:=b2.id+1;
end;
seekbfile (numbuls+1);
write (bfile,b);
close (bfile);
end;
begin
openbdfile;
thefn:=strr(conn)+'NET'+curboard.shortname+'.ZIP';
filename:='NETRECV'+strr(conn)+'.ZIP';
ourf:=copy (thefn,1,length(thefn)-4);
ourf2:=copy (thefn,1,length(filename)-4);
numb:=filesize(bdfile);
writeln (usr,'[Working with ',upstring(ourf2),']');
for cnt:=1 to numb do
seekbdfile (cnt);
if curboard.net then begin
begin
writeln (usr,'[Status: UnZipping File]');
delay (100);
extractzip('',networkdir+thefn,copy (datadir,1,length(datadir)-1));
assign(sqlf,networkdir+ourf+'.SQ'+strr(conn));
{$I+} reset (sqlf); {$I-}
assign(mesf,networkdir+ourf+'.ME'+strr(conn));
{$I+} reset (mesf); {$I-}
end;
writeln (usr,'[Status: Writing Messages to Message Base]');
while not eof(sqlf) do
begin
read(sqlf,b);
read(mesf,textf);
b.line:=maketext(textf);
addbul(b);
delay (10);
end;
close(sqlf);
close(mesf);
erase(sqlf);
erase(mesf);
writeln(usr,'[Status: UnZipping and Processing Complete. Deleting FAQNet-Paket]');
assign (f1,networkdir+thefn);
erase (f1);
end;
closebdfile;
end;
function checklog:string;
var f:text;
xferfile,code,l:anystr;
c:string[1];
done:boolean;
x:integer;
function parsespaces (s:anystr):anystr;
var p,pee,xy:integer;
k,j:char;
r:anystr;
begin
parsespaces:=s;
r:=s;
repeat
p:=pos (' ',r);
if p>0 then begin
delete (r,p,1);
end;
until p=0;
parsespaces:=r;
end;
begin
checklog:=' ';
if not exist (dszlogname) then begin
writeln (^G'DSZLOG Error.'^M);
exit;
end;
assign (f,dszlogname);
reset (f);
code:='';
xferfile:='';
readln (f,l);
code:=copy (l,1,1);
c:='';
x:=50;
repeat
x:=x+1;
if c='/' then c:='\';
xferfile:=xferfile+c;
c:=copy (l,x,1);
until c=' ';
textclose (f);
xferfile:=parsespaces (xferfile);
checklog:=xferfile;
writeln (usr,'[Code: ',upstring(code[1]),'] [Filename: ',upstring(xferfile),']');
end;
procedure rnetmail;
var yo:byte;
f1:file;
thefn:sstr;
a:sstr;
filename2,filename3:file;
begin
clrscr;
{if exist (dszlogname) then begin
assign (f1,dszlogname);
erase (f1);
end;}
{writestr('Netmail Conference [1-5]: *');
conn:=valu(input);}
writeln(usr,'[Status: Receiving Net Mail]');
assign(filename3,networkdir+'NETSEND'+strr(conn)+'.ZIP');
if exist(networkdir+'NETSEND'+strr(conn)+'.ZIP') then
rename(filename3,networkdir+'NETTEMP'+strr(conn)+'.ZIP');
yo:=doext ('R','Z',networkdir,'NETSEND'+strr(conn)+'.ZIP',baudrate,usecom);
{yo:=0;}
if yo=0 then begin
writeln(usr,^M^M);
writeln(usr,'[Status: Checking File Received]');
assign(filename2,networkdir+'NETSEND'+strr(conn)+'.ZIP');
rename(filename2,networkdir+'NETRECV'+strr(conn)+'.ZIP');
thefn:='NETRECV'+strr(conn)+'.ZIP';
writeln(usr,'[File Received: ',upstring(thefn),']');
a:=copy (thefn,length(thefn)-3,4);
if not (match(a,'.ZIP')) then begin
writeln (usr,'[Status: File Received is not a ZipFile, Deleting]');
assign (f1,networkdir+thefn);
erase (f1);
writeln (usr,'[File Deleted]');
end else begin
if netsubs then begin
dounzipnetmail;
end;
if netnews then begin
chdir (networkdir);
extractzip (networkdir+'NETSEND.ZIP','NEWS.NET',networkdir);
chdir (faqdir);
end;
if netupgrade then begin
chdir (networkdir);
extractzip (networkdir+'NETSEND.ZIP','UPGRADE.ZIP',networkdir);
end;
end;
end;
assign(filename3,networkdir+'NETTEMP'+strr(conn)+'.ZIP');
if exist(networkdir+'NETTEMP'+strr(conn)+'.ZIP') then
rename(filename3,networkdir+'NETSEND'+strr(conn)+'.ZIP');
unum:=-1;
delay (100);
writeln ('Netmail Package Processed.');
disconnect;
end;